home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / ratmac.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  3.6 KB  |  138 lines

  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module ratmac macro)
  13.  
  14. ;; Macros for manipulating rational functions.
  15.  
  16. (DEFMACRO PCOEFP (E) `(ATOM ,E))
  17.  
  18.  
  19.  
  20. #-CL
  21. (DEFMACRO PZEROP (X) `(SIGNP E ,X))            ;TRUE FOR 0 OR 0.0
  22. ;;;(DEFMACRO PZEROP (X) `(LET ((gg1032 ,X)) (AND (NUMBERP gg1032) (ZEROP gg1032))))
  23.  
  24. (proclaim '(inline pzerop))
  25. #+CL
  26. (defun pzerop (x) (if (fixnump x) (zerop (the fixnum x))
  27.             (if (consp x) nil
  28.               (and (floatp x) (zerop x)))))
  29.  
  30. #+CL
  31. (DEFMACRO PZERO () 0)
  32. (DEFMACRO PTZEROP (TERMS) `(NULL ,TERMS))        ;for poly terms
  33. (DEFMACRO PTZERO () '())
  34.  
  35. #-CL
  36. (DEFMACRO CZEROP (C) `(SIGNP E ,C))
  37. #+CL
  38. (defmacro czerop (c) `(pzerop ,c))
  39.  
  40. (DEFMACRO CMINUS (C) `(MINUS ,C))
  41. (DEFMACRO CMINUSP (C) `(MINUSP ,C))
  42. (DEFMACRO CDERIVATIVE (ign ign1)ign ign1 0)
  43.  
  44. ;; Similar to REMOVE on the Lisp Machine
  45. (DEFMACRO DELET (ITEM LLIST) `(ZL-DELETE ,ITEM (COPY-TOP-LEVEL ,LLIST )))
  46.  
  47. ;; the rational function package uses GENSYM's to represent variables.
  48. ;; The PDP-10 implementation used to use the PRINTNAME of the gensym
  49. ;; as a place to store a VALUE. Somebody changed this to value-cell instead,
  50. ;; even though using the value-cell costs more. Anyway, in NIL I want it
  51. ;; to use the property list, as thats a lot cheaper than creating a value
  52. ;; cell. Actually, better to use the PACKAGE slot, a kludge is a kludge right?
  53.  
  54. (DEFMACRO VALGET (ITEM)
  55.   #+NIL `(GET ,ITEM 'GENSYMVAL)
  56.   #-NIL `(SYMBOL-VALUE ,ITEM))
  57.  
  58. (DEFMACRO VALPUT (ITEM VAL)
  59.   `(SETF (VALGET ,ITEM) ,VAL))
  60.  
  61. (proclaim '(inline pointergp))
  62. (DEFun POINTERGP (A B) (f> (valget A) (VALGET B)))
  63.  
  64. ;(macro ALGV (L) `(AND $ALGEBRAIC (GET ,(CADR L) 'TELLRAT)))
  65. (defmacro algv (v)
  66.   `(and $algebraic (get ,v 'tellrat)))
  67.  
  68.  
  69. (DEFMACRO EQN (&REST L) `(EQUAL . ,L))
  70.  
  71. (DEFMACRO RZERO () ''(0 . 1))
  72. (DEFMACRO RZEROP (A) `(PZEROP (CAR ,A)))
  73.  
  74. (defmacro PRIMPART (p) `(cadr (oldcontent ,p)))
  75.  
  76. ;;poly constructor
  77.  
  78. (defmacro make-poly (var &optional (terms-or-e nil options?) (c nil e-c?)
  79.              (terms nil terms?))
  80.   (cond ((null options?) `(cons ,var '(1 1)))
  81.     ((null e-c?) `(psimp ,var ,terms-or-e))
  82.     ((null terms?) `(list ,var ,terms-or-e ,c))
  83.     (t `(psimp ,var (list* ,terms-or-e ,c ,terms)))))
  84.  
  85. ;;Poly selector functions
  86.  
  87. (defmacro P-VAR (p) `(car ,p))
  88.  
  89. (defmacro P-TERMS (p) `(cdr ,p))
  90.  
  91. (defmacro P-LC (p) `(caddr ,p))            ;leading coefficient
  92.  
  93. (defmacro P-LE (p) `(cadr ,p))
  94.  
  95. (defmacro P-RED (p) `(cdddr ,p))
  96.  
  97. ;;poly terms selectors
  98.  
  99. (defmacro PT-LC (terms) `(cadr ,terms))
  100.  
  101. (defmacro PT-LE (terms) `(car ,terms))
  102.  
  103. (defmacro PT-RED (terms) `(cddr ,terms))
  104.  
  105. ;; Taken from SININT and RISCH.  Somebody document these please.
  106.  
  107. (DEFMACRO R+ (R . L)
  108.       (COND ((NULL L) R)
  109.         (T `(RATPL ,R (R+ ,@L)))))
  110.  
  111. (DEFMACRO R* (R . L)
  112.       (COND ((NULL L) R)
  113.         (T `(RATTI ,R (R* ,@L) T))))
  114.  
  115. (DEFMACRO R- (R . L)
  116.       (COND ((NULL L) `(RATMINUS (RATFIX ,R)))
  117.         (T `(RATDIF (RATFIX ,R) (R+ ,@L)))))
  118.  
  119.  
  120. (defvar $ratvarswitch t)
  121.  
  122. ;(defvar *rational-function-files* '(
  123. ;ratmac
  124. ;rat3a
  125. ;rat3b
  126. ;rat3c
  127. ;rat3e
  128. ;nrat4
  129. ;ratout
  130. ;lesfac
  131. ;factor
  132. ;algfac
  133. ;nalgfa
  134. ;newfac
  135. ;ufact
  136. ;result
  137. ;spgcd))
  138.